ASME's Mechanical Engine…ing Toolkit 1997 December/ASME's Mechanical Engineering Toolkit 1997 December.iso/basic/qbuddy21.lzh/QBUDDY21.BAS

BASIC Source File | 1988-04-20 | 66KB | 1,850 lines

DECLARE SUB Help (PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, SYS.PATH$)
DECLARE SUB hold ()
DECLARE SUB Sclr (fc%, bc%)
DECLARE SUB tyme ()
DECLARE SUB menu (fgd!, BKGD!, brdr!, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)
DECLARE SUB box (r1%, c1%, R2%, c2%, men%)
DECLARE SUB box.text (MSG$, row%, col%, front, back, ofront, oback)
DECLARE SUB center (whichline!, tl$)
DECLARE SUB rsmg (whichline!, tl$)
DECLARE SUB infile (PAT.PATH$, APT.PATH$, inflg%, FILENAME$, fc%, bc%, SYS.PATH$, ERCD%, handle%, faccess%, mode%, SUB.PATH$)
'=======================================
' Just a bunch of source code. Kinda
' useful for some and elementary for
' most. Must use Quickbasic 4.0 and
' Thomas Hanlin's ADVBAS40/99.
' QB QBUDDY.BAS /L ADVBAS - To Load
' Free - Joe Lincoln - LINX BBS - [phone]
'=======================================
Joe:
' Quick B
' QBUDDY SETUP
' Version QB21
endofdata = FALSE
ON ERROR GOTO 40000
' init
    KEY OFF: EL = 0: EN = 0: KEY 1, CHR$(201): KEY 2, CHR$(202): KEY 3, CHR$(203): KEY 4, CHR$(204): KEY 5, CHR$(205)
    KEY 6, CHR$(206): KEY 7, CHR$(207): KEY 8, CHR$(208): KEY 9, CHR$(209)
    DEF fnf$ (x) = RIGHT$("0" + MID$(STR$(x), 2), 2)
    DIM PI$(5), Y(5), x(5), API$(16), RCC$(24), RC$(24), TC$(25), AC$(25), MD(12), MO$(12), DA$(8), LOCKS$(3)
    DIM SHARED m$(10), np, CH, yn$, text$(10), col$(15)
    DIM NOYES$(2): NOYES$(0) = "NO ": NOYES$(1) = "YES"
    DIM YESNO$(2): YESNO$(0) = "YES": YESNO$(1) = "NO "
    DIM ONOFF$(2): ONOFF$(0) = "OFF": ONOFF$(1) = "ON "
    DIM MON$(4): MON$(0) = "40x25 Mono ": MON$(1) = "40x25 Color": MON$(2) = "80x25 Color": MON$(3) = "80x25 Mono "
    DIM HRDSK$(16): DIM SYSBRD(16): DIM SHARED SETMM(16)
    DIM PRI$(14), parm$(8), h(8), v(8), LN(8), item%(8), J(8)
    LOCKS$(0) = STRING$(7, 219): LOCKS$(1) = STRING$(4, 219) + "NUM"
    LOCKS$(2) = "CAP" + STRING$(4, 219): LOCKS$(3) = "CAP" + CHR$(219) + "NUM"
    NTR$ = CHR$(13): BKSP$ = CHR$(8): ESC$ = CHR$(2): UP$ = CHR$(24): DN$ = CHR$(25)
    RT$ = CHR$(26): LF$ = CHR$(27): BREAK$ = CHR$(3): ENTR$ = " " + CHR$(17) + STRING$(2, 196) + CHR$(217) + " "
    NUMS = 1: CAPS = 2
    DEF SEG = 0: IF (PEEK(H410) AND H30) <> &H30 THEN HL = 15
    LF.CURSOR = 75: RT.CURSOR = 7: END.KEY = 79: INS.KEY = 82: DEL.KEY = 83: HOME = 71
    DN.CURSOR = 80: UP.CURSOR = 72: CTRL.END = 117: ESC = 27: CTRL.RT = 116: CTRL.LF = 115: PG.UP = 73: PG.DN = 81
    YES = NOT no: no = NOT YES
    B1$ = CHR$(196) + CHR$(210)
    B1$ = CHR$(218) + B1$ + B1$ + B1$ + B1$ + B1$ + B1$ + B1$ + CHR$(196) + CHR$(191)
    B2$ = " " + CHR$(186)
    B2$ = CHR$(179) + B2$ + B2$ + B2$ + B2$ + B2$ + B2$ + B2$ + " " + CHR$(179)
    B3$ = B2$
    B4$ = CHR$(196) + CHR$(208)
    B4$ = CHR$(192) + B4$ + B4$ + B4$ + B4$ + B4$ + B4$ + B4$ + CHR$(196) + CHR$(217)
    v(1) = 6: h(1) = 28: LN(1) = 15 'sys.path
    v(2) = 7: h(2) = 28: LN(2) = 15 'pat.path
    v(3) = 8: h(3) = 28: LN(3) = 15 'apt.path
    v(4) = 9: h(4) = 28: LN(4) = 15 'act.path
    v(5) = 10: h(5) = 20: LN(5) = 40 'prog.name
    v(6) = 11: h(6) = 17: LN(6) = 2 'fc%
    v(7) = 12: h(7) = 17: LN(7) = 2 'bc%
    v(8) = 13: h(8) = 14: LN(8) = 15 'sub.path

    Y(1) = 8: x(1) = 20: Y(2) = 10: x(2) = 20: Y(3) = 12: x(3) = 20: Y(4) = 14: x(4) = 20
    MD(1) = 31: MD(3) = 31: MD(4) = 30: MD(5) = 31: MD(6) = 30: MD(7) = 31: MD(8) = 31: MD(9) = 30: MD(10) = 31: MD(11) = 30: MD(12) = 31
    MO$(1) = "JANUARY": MO$(2) = "FEBRUARY": MO$(3) = "MARCH": MO$(4) = "APRIL": MO$(5) = "MAY": MO$(6) = "JUNE": MO$(7) = "JULY": MO$(8) = "AUGUST": MO$(9) = "SEPTEMBER": MO$(10) = "OCTOBER": MO$(11) = "NOVEMBER": MO$(12) = "DECEMBER"
    DA$(1) = "MONDAY": DA$(2) = "TUESDAY": DA$(3) = "WEDNESDAY": DA$(4) = "THURSDAY": DA$(5) = "FRIDAY": DA$(6) = "SATURDAY": DA$(7) = "SUNDAY": DA$(8) = "ERROR"
    HB1$ = CHR$(196): HB2$ = CHR$(205): HB3$ = CHR$(220): VB1$ = CHR$(179): VB2$ = CHR$(186): VB3$ = CHR$(219): ULC1$ = CHR$(218): URC1$ = CHR$(191): LLC1$ = CHR$(192): LRC1$ = CHR$(217): ULC2$ = CHR$(201): URC2$ = CHR$(187): LLC2$ = CHR$(200): _
                                                                                                          LRC2$ = CHR$(188)
    ULC3$ = CHR$(220): URC3$ = CHR$(220): LLC3$ = CHR$(219): LRC3$ = CHR$(219): ML11$ = CHR$(195): MR11$ = CHR$(180): ML22$ = CHR$(204): MR22$ = CHR$(185): HB771$ = STRING$(77, HB1$): HB772$ = STRING$(77, HB2$): HB773$ = STRING$(77, HB3$): SP77$ _
 = STRING$(77, 32)
    ENTSYMB$ = CHR$(17) + CHR$(196) + CHR$(196) + CHR$(217)
    PARAM$ = "AMPARAM.DAT"
    H1$ = STRING$(80, 61): CLR$ = STRING$(80, 32): H5$ = STRING$(80, 31)
    DATA Black,Blue,Green,Cyan,Red,Magenta,Brown-Yellow,White,Gray,Light Blue,Light Green,Light Cyan,Light Red,Light Magenta,Yellow,High-White
    FOR L = 0 TO 15: READ col$(L): NEXT L
    DATA    ( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER ),( WHATEVER )
    DATA   (emergency ),(  paper   ),(up winnie ),(low winnie),(deliv rug ),( consult  ),(part body ),( panorex  ),( bull s...),(cement pot),(fit lining),(cem lining),(forginimpr)
    FOR L = 1 TO 25: READ TC$(L)
    NEXT L
    DATA EX,RC,RB,CK,BL,BU,SP,RE,BUL,RI,FP,CB,SOS,PA,UW,LW,RT,CO,PB,PX,BS,CP,FL,CL,FI
    FOR L = 1 TO 25: READ AC$(L)
    NEXT L
    DATA BASIC RECALL,CALLBACK,FAILED RETURN,FAILED ACTIVE,TWO APPT,DOCTOR APPT,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED,RESERVED
    FOR L = 1 TO 24: READ RC$(L): NEXT L
    DATA BR,CB,FR,FA,TJ,DX,MT,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE,RE
    FOR L = 1 TO 24: READ RCC$(L): NEXT L
    LCOL% = 5: TROW% = 5: RCOL% = 79: BROW% = 20: page% = 0: FRAME% = 1: ty% = 3

'GOSUB write.rc.ovl: END

GOSUB read.parm: GOSUB read.tc.ovl: GOSUB read.rc.ovl: GOSUB logo: GOSUB main.menu: CLS : END
40 'Edit AMPARM.DAT
        AMPARM$ = "AMPARM.DAT"
        UP$ = CHR$(24): DN$ = CHR$(25): LF$ = CHR$(27): RT$ = CHR$(26)
        CALL Sclr(fc%, bc%)
        LABEL$ = "Write Configuration File"
        CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)
        CALL equipment(memory%, parallel%, seriel%, game%)
    a$ = ver$: center 2, a$
    LOCATE 6, 5: PRINT "Default Program Drive :";
    LOCATE 7, 5: PRINT "CLIENT File Path     :";
    LOCATE 8, 5: PRINT "APPOINTMENT File Path :";
    LOCATE 9, 5: PRINT "ACCOUNTING  File Path :";
    LOCATE 10, 5: PRINT "Program name :";
    LOCATE 11, 5: PRINT "FORE color:";
    LOCATE 12, 5: PRINT "BACK color:";
    LOCATE 13, 5: PRINT "SubDir  :";
GOSUB overlay

LOCATE 14, 6: COLOR bc%, fc%: PRINT "============ HARDWARE ============"; : COLOR fc%, bc%

    LOCATE 15, 5: PRINT "Memory in RAM        = "; memory%; " kbytes"
    LOCATE 16, 5: PRINT "Number printer ports = "; parallel%
    LOCATE 17, 5: PRINT "Number serial ports  = "; seriel%
    LOCATE 18, 5: PRINT "Number game ports    = "; game%
    LOCATE 19, 5: PRINT "MS-DOS version       = "; maj%; "."; min%;
    LOCATE 20, 5: PRINT "Printer Installed    = "; PRINTER$;
    'CALL mmcheck(mouse%)
    'IF mouse% THEN LOCATE 20, 5: PRINT "A mouse with "; mouse%; " buttons is present."
LOCATE 12, 46: COLOR bc%, fc%: PRINT "======= COLOR SELECTIONS =======";
    COLOR fc%, bc%
    v = 13
     FOR col% = 0 TO 7
    LOCATE v, 45: PRINT col%; " ";
    COLOR col%, bc%
    LOCATE v, 48: PRINT col$(col%);
    COLOR fc%, bc%
    v = v + 1
     NEXT col%
    v = 13
     FOR col% = 8 TO 15
    LOCATE v, 60: PRINT col%; " ";
    COLOR col%, bc%
    LOCATE v, 64: PRINT col$(col%);
    COLOR fc%, bc%
    v = v + 1
     NEXT col%
        a$ = STRING$(70, 32)
        center 23, a$: center 24, a$
        a$ = "Press ESCape To EXIT or Any Key To Edit"
        CALL center(23, a$)
        GOSUB 1000
        IF a = 27 THEN RETURN
        a$ = STRING$(70, 32)
        center 23, a$: center 24, a$
        a$ = "Just enter RETurn to accept current data."
        CALL center(23, a$)

 GOSUB enterdata: GOTO 60


overlay:
    a$ = STRING$(40, 32): AA$ = STRING$(10, 32): AAA$ = STRING$(3, 32)
    LOCATE 6, 28: PRINT AA$; : LOCATE 6, 28: PRINT SYS.PATH$
    LOCATE 7, 28: PRINT AA$; : LOCATE 7, 28: PRINT PAT.PATH$
    LOCATE 8, 28: PRINT AA$; : LOCATE 8, 28: PRINT APT.PATH$
    LOCATE 9, 28: PRINT AA$; : LOCATE 9, 28: PRINT ACT.PATH$
    LOCATE 10, 20: PRINT a$; : LOCATE 10, 20: PRINT PROG.NAME$
    LOCATE 11, 16: PRINT AAA$; : LOCATE 11, 16: PRINT fc%
    LOCATE 12, 16: PRINT AAA$; : LOCATE 12, 16: PRINT bc%
    LOCATE 13, 14: PRINT AA$; : LOCATE 13, 14: PRINT SUB.PATH$
RETURN


joekey:
WD = 0: WS = 0: WL = 0: WI = 1: SOUND 80, .03: MOVE.IT = no: KY = 0: in$ = INKEY$
QX = POS(0): QY = CSRLIN
QC$ = control$: control$ = "": IF QC$ = "" THEN QC = no: GOTO pugin ELSE QC = YES
IF INSTR("U#_", MID$(QC$, WI, 1)) = 0 THEN WI = WI + 1: GOTO pug1
pugin:
    CHAR.CODE = FIX(FL / 100): IF CHAR.CODE > 0 THEN FL = FL - CHAR.CODE * 100
    IF PROMPT$ = "" THEN in$ = SPACE$(FL): GOTO pug2
    in$ = LEFT$(PROMPT$ + SPACE$(FL), FL): WL = LEN(PROMPT$): PROMPT$ = ""
pug1: IF MID$(in$, WL, 1) = " " THEN WL = WL - 1: IF WL >= 0 THEN GOTO pug1
pug2: COLOR bc%, fc%
pug3: LOCATE QY, QX, 1: PRINT in$;
pug4: LOCATE QY, QX + WI - 1
pug5: W$ = INKEY$: DEF SEG = &H40: QK = PEEK(&H17) AND 96:
    IF QK1 <> QK THEN LOCATE 25, 73: PRINT LOCKS$(QK / 32); : QK1 = QK: SOUND 400 + QK, .3: GOTO pug4
    IF W$ = "" THEN GOTO pug5
    IF W$ = BREAK$ THEN GOTO lastpug
    IF LEN(W$) = 1 THEN GOTO pug18 ELSE KY = ASC(RIGHT$(W$, 1))
    IF QC THEN GOTO pug6
    IF KY = INS.KEY THEN IF INSERT = no THEN INSERT = YES: LOCATE , , , 4, 13: GOTO pug3 ELSE INSERT = no:                             LOCATE , , , 13: GOTO pug5
pug6: IF KY = RT.CURSOR THEN WI = WI - (WI < WL): GOTO pug4
    IF KY = LF.CURSOR THEN WI = WI + (WI > 1): GOTO pug4
    IF KY = DEL.KEY THEN IF NOT QC THEN in$ = LEFT$(in$, WI - 1) + RIGHT$(in$, FL - WI) + " ": WL = WL - 1: GOTO pug3 ELSE MID$(in$, WI, 1) = " ": GOTO pug3
    IF INSERT THEN INSERT = no: LOCATE , , , 13
    IF KY = HOME THEN WI = 1: GOTO pug4
    IF KY = END.KEY THEN WI = WL + 1: GOTO pug4
    IF KY = CTRL.END THEN in$ = LEFT$(in$, WI - 1) + SPACE$(FL - WI + 1): WL = WI - 1: GOTO pug3
    IF KY <> CTRL.RT OR WI = WL + 1 THEN GOTO pug7
pug19:  WI = WI + 1: IF WI = WL + 1 THEN GOTO pug4 ELSE IF MID$(in$, WI - 1, 1) = " " THEN GOTO pug4 ELSE GOTO pug19
pug7: IF KY <> CTRL.LF OR WI = 1 THEN GOTO pug8
    QC$ = control$: control$ = "": IF QC$ = "" THEN QC = no ELSE QC = YES
pug20:  WI = WI - 1: IF WI = 1 THEN GOTO pug4 ELSE IF MID$(in$, WI - 1, 1) = " " THEN GOTO pug4 ELSE GOTO pug20
pug8: MOVE.IT = YES: GOTO going
pug18:  IF W$ = NTR$ THEN GOTO going
    IF W$ = ESC$ THEN KY = ESC: MOVE.IT = YES: GOTO going
pug21:  IF NOT QC THEN GOTO pug10
    IF W$ <> BKSP$ THEN GOTO pug9
    IF WI > 1 THEN WI = WI - 1: Q$ = MID$(QC$, WI, 1) ELSE GOTO pug3
    IF INSTR("#U_", Q$) = 0 THEN GOTO pug21 ELSE MID$(in$, WI, 1) = " ": GOTO pug3
pug9: IF WI > FL THEN GOTO pug10
    Q$ = MID$(QC$, WI, 1)
    IF Q$ = "#" THEN CHAR.CODE = NUMS: GOTO pug10
    IF Q$ = "U" THEN CHAR.CODE = CAPS: GOTO pug11
    IF Q$ = "_" THEN CHAR.CODE = 0: GOTO pug11
    W$ = Q$: GOTO pug12
pug10: IF CHAR.CODE = NUMS THEN IF (W$ = "-" AND WI > 1) OR W$ = "+" THEN in$ = W$ + in$: GOTO going:
pug11: IF WI > FL THEN GOTO pug13
    IF CHAR.CODE = 0 THEN IF W$ >= " " AND W$ <= "~" THEN GOTO pug12
    IF CHAR.CODE = NUMS THEN IF W$ >= "0" AND W$ <= "9" THEN GOTO pug12
    IF CHAR.CODE = CAPS THEN IF W$ >= "a" AND W$ <= "z" THEN W$ = CHR$(ASC(W$) - 32): GOTO pug12 ELSE IF W$ >= " " AND W$ < "a" THEN GOTO pug12
pug13: IF W$ = BKSP$ THEN IF WI > 1 THEN in$ = LEFT$(in$, WI - 2) + RIGHT$(in$, FL - WI + 1) + " ": WL = WL - 1: WI = WI - 1: GOTO pug3
    GOTO pug5
pug12: IF NOT INSERT THEN MID$(in$, WI, 1) = W$ ELSE IF WL < FL THEN WL = WL + 1:      in$ = LEFT$(LEFT$(in$, WI - 1) + W$ + RIGHT$(in$, FL - WI + 1), FL): WI = WI + 1: GOTO pug3 ELSE GOTO pug5
    IF WI > 1 THEN GOTO pug15
    IF NOT QC THEN in$ = W$ + SPACE$(FL - 1): GOTO pug14
    FOR QQ = 2 TO FL: IF INSTR("#u=UI_", MID$(QC$, QQ, 1)) > 0 THEN MID$(in$, QQ, 1) = " "
    NEXT QQ
pug14: LOCATE , QX: PRINT in$; : LOCATE , QX: WL = 1
pug15: PRINT W$;
    WI = WI + 1: IF WI > WL THEN WL = WI - 1
    IF WI >= FL THEN GOTO pug16
    IF QC THEN Q$ = MID$(QC$, WI, 1): IF INSTR("#Ul_", Q$) = 0 THEN W$ = Q$: GOTO pug12
pug16: IF FL > 2 OR WL < FL THEN GOTO pug3
going: COLOR fc%, bc%: LOCATE QY, QX, , 13: PRINT in$; : in$ = LEFT$(in$, WL): INSERT = no: RETURN

    LOCATE 25, 29
    U$ = "press|" + ENTR$ + "|to continue": GOSUB pug17: FL = 0: GOSUB joekey
    RETURN

pug17: U = 1: ULEN = LEN(U$): U1 = fc%: U2 = 7
pug22:  UU = INSTR(U, U$, "|"): UU = UU - (UU = 0) * (ULEN + 1): PRINT MID$(U$, U, UU - U); : U = UU + 1: SWAP U1, U2: COLOR U1: IF ULEN > U OR U = 1 THEN GOTO pug22 ELSE COLOR fc%, bc%
    RETURN
lastpug:
RETURN

enterdata:
a$ = STRING$(50, 32): center 23, a$
QK1 = 0: LOCATE 23, 11: U$ = UP$ + "-|prior line.|  " + DN$ + "-|next line.|  PgUp-|first line.|  PgDn-|last line.|": GOSUB pug17
LOCATE 24, 10: PRINT "Cursor control keys";
PRINT ":   "; LF$; "  "; RT$; "  CTRL"; LF$; "  CTRL"; RT$; "  Home  End  Ins  Del"

topgun:

    J = 1
    item% = J

getiton:

        PROMPT$ = ""
        LOCATE v(J), h(J): FL = LN(J)
        QX = POS(0): QY = CSRLIN

'build prompt
        FOR x = QX TO QX + FL
            LETTER$ = CHR$(SCREEN(QY, x))
            PROMPT$ = PROMPT$ + LETTER$
        NEXT x

        item% = J: parm$(item%) = PROMPT$
        LOCATE v(J), h(J)
        GOSUB joekey
        IF NOT MOVE.IT THEN GOTO chngit
'moveit:
    IF KY = UP.CURSOR THEN GOTO uparrow
    IF KY = DN.CURSOR THEN GOTO dnarrow
    IF KY = PG.UP THEN J = 1: GOSUB saveasis: GOTO getiton
    IF KY = PG.DN THEN J = 8: GOSUB saveasis: GOTO getiton
    IF KY = ESC THEN RETURN

chngit: IF in$ <> "" THEN parm$(J) = in$ ELSE parm$(J) = PROMPT$
    IF J < 8 THEN J = J + 1:  GOTO getiton
    GOTO exitedit

uparrow:

    J = J + (J > 1): GOTO getiton

dnarrow:

    J = J - (J < 8): GOTO getiton

saveasis:
    LETTER$ = ""
    FOR item% = 1 TO 8
        parm$(item%) = ""
        LOCATE v(item%), h(item%)
        QX = POS(0): QY = CSRLIN

        FL = LN(item%)
            FOR x = QX TO QX + FL
                LETTER$ = CHR$(SCREEN(QY, x))
                parm$(item%) = parm$(item%) + LETTER$
            NEXT x
            LETTER$ = ""
    NEXT item%
    RETURN

exitedit:

    GOSUB saveasis
    SYS.PATH$ = parm$(1): PAT.PATH$ = parm$(2): APT.PATH$ = parm$(3)
    ACT.PATH$ = parm$(4): PROG.NAME$ = parm$(5)
    fc$ = parm$(6): fc% = VAL(parm$(6))
    bc$ = parm$(7): bc% = VAL(parm$(7))
    SUB.PATH$ = parm$(8)
    GOSUB overlay
    GOSUB write.parm
    RETURN

60 '
write.parm:
    AMPARM$ = "AMPARM.DAT"
    SYS.PATH$ = RTRIM$(SYS.PATH$)
    PAT.PATH$ = RTRIM$(PAT.PATH$)
    APT.PATH$ = RTRIM$(APT.PATH$)
    ACT.PATH$ = RTRIM$(ACT.PATH$)
    PROG.NAME$ = RTRIM$(PROG.NAME$)
    SUB.PATH$ = RTRIM$(SUB.PATH$)
    PRINTER$ = RTRIM$(PRINTER$)
    OPEN AMPARM$ FOR OUTPUT AS #1
    WRITE #1, SYS.PATH$, PAT.PATH$, APT.PATH$, ACT.PATH$, PROG.NAME$, fc%, bc%, SUB.PATH$, PRINTER$, ver$
    CLOSE #1
RETURN


65 '
read.parm:
    AMPARM$ = "AMPARM.DAT"
    OPEN AMPARM$ FOR INPUT AS #1
    INPUT #1, SYS.PATH$, PAT.PATH$, APT.PATH$, ACT.PATH$, PROG.NAME$, fc%, bc%, SUB.PATH$, PRINTER$, ver$
    CLOSE #1
    IF PRINTER$ = "" OR LEN(PRINTER$) < 5 THEN prnfile$ = "AMPRINT.DAT" ELSE
    IF PRINTER$ = "APPLE DMP" THEN prnfile$ = "APPLE.PRN" ELSE
    IF PRINTER$ = "TOSHIBA P1340" THEN prnfile$ = "TOSH1340.PRN" ELSE
    IF PRINTER$ = "FX 100" THEN prnfile$ = "FX100.PRN" ELSE
    IF PRINTER$ = "FX 80" THEN prnfile$ = "FX80.PRN" ELSE
    IF PRINTER$ = "C-ITOH" THEN prnfile$ = "CITOH.PRN" ELSE
    prnfile$ = LEFT$(PRINTER$, 5) + ".PRN"

    GOSUB read.prnfile

    RETURN
parm.trap:
    CLS : fc% = 15: bc% = 0
    center 12, "AMPARM.DAT File Missing"
    center 14, "Create NEW File (Y-N)"
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN RETURN
    DRV$ = "x:": CALL GETDRV(DRV$)
    DRV$ = DRV$ + "\"
    SUB$ = STRING$(64, 0)
    CALL GETSUB(SUB$, slen%)
    SUB$ = "\" + LEFT$(SUB$, slen%)
    CALL stripblanks(SUB$, 3, slen%)
    SUB$ = LEFT$(SUB$, slen%)
    SYS.PATH$ = DRV$: SUB.PATH$ = SUB$: PAT.PATH$ = DRV$ + "CLIENT\": APT.PATH$ = DRV$ + "APPOINT\": ACT.PATH$ = DRV$ + "CLIENT\"
    PRINTER$ = "APPLE DMP": PROG.NAME$ = "Program Practice Name": ver$ = "Series 8.0": fc% = 15: bc% = 0
    AMPARM$ = "AMPARM.DAT"
    SYS.PATH$ = RTRIM$(SYS.PATH$)
    PAT.PATH$ = RTRIM$(PAT.PATH$)
    APT.PATH$ = RTRIM$(APT.PATH$)
    ACT.PATH$ = RTRIM$(ACT.PATH$)
    PROG.NAME$ = RTRIM$(PROG.NAME$)
    SUB.PATH$ = RTRIM$(SUB.PATH$)
    PRINTER$ = RTRIM$(PRINTER$)
    OPEN AMPARM$ FOR OUTPUT AS #1
    WRITE #1, SYS.PATH$, PAT.PATH$, APT.PATH$, ACT.PATH$, PROG.NAME$, fc%, bc%, SUB.PATH$, PRINTER$, ver$
    CLOSE #1

    RETURN

70 '
printer.install:
GOSUB read.prnfile
CLS : nochange = 0
LABEL$ = "Select Printers"
CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)

    a$ = "The following printers are supported:"
    CALL center(6, a$)
pimenu:

    m$(1) = "APPLE DOT MATRIX"
    m$(2) = "C-ITOH DOT MATRIX"
    m$(3) = "EPSON FX 80 DMP"
    m$(4) = "EPSON FX 100 DMP"
    m$(5) = "TOSHIBA P1340 HDMP"
    m$(6) = "HP LASER JET II"
    m$(7) = "Reserved"
    m$(8) = "CUSTOM Printer CODES"
    m$(9) = "EXIT To Main Menu"

np = 9
fc = FC2%: bc = BC2%
CALL menu(fc, bc, bc, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)

a = CH
response:
    IF a = 27 THEN RETURN
    IF a = 1 THEN PRINTER$ = "APPLE DMP": GOSUB prnfile: GOTO printer.install
    IF a = 2 THEN PRINTER$ = "C-ITOH": GOSUB prnfile: GOTO printer.install
    IF a = 3 THEN PRINTER$ = "FX 80": GOSUB prnfile: GOTO printer.install
    IF a = 4 THEN PRINTER$ = "FX 100": GOSUB prnfile: GOTO printer.install
    IF a = 5 THEN PRINTER$ = "TOSHIBA P1340": GOSUB prnfile: GOTO printer.install
    IF a = 6 THEN PRINTER$ = "HPLJII": GOSUB prnfile: GOTO printer.install
    IF a = 7 THEN PRINTER$ = "": GOTO printer.install
    IF a = 8 THEN GOSUB custprncodes: GOTO printer.install
    IF a = 9 THEN RETURN

prnfile:
    CLS
    IF PRINTER$ = "APPLE DMP" THEN prnfile$ = "APPLE.PRN"
    IF PRINTER$ = "TOSHIBA P1340" THEN prnfile$ = "TOSH1340.PRN"
    IF PRINTER$ = "FX 100" THEN prnfile$ = "FX100.PRN"
    IF PRINTER$ = "FX 80" THEN prnfile$ = "FX80.PRN"
    IF PRINTER$ = "C-ITOH" THEN prnfile$ = "CITOH.PRN"
    IF PRINTER$ = "HPLJII" THEN prnfile$ = "HPLJII.PRN"
    IF PRINTER$ = "" THEN prnfile$ = "AMPRINT.DAT"

    GOSUB custprncodes
    IF nochange = 1 THEN RETURN ELSE
    GOSUB write.parm: RETURN
RETURN
read.prnfile:
100 '
    QUOTE$ = CHR$(34)
    IF PRINTER$ = "APPLE DMP" THEN prnfile$ = "APPLE.PRN"
    IF PRINTER$ = "TOSHIBA P1340" THEN prnfile$ = "TOSH1340.PRN"
    IF PRINTER$ = "FX 100" THEN prnfile$ = "FX100.PRN"
    IF PRINTER$ = "FX 80" THEN prnfile$ = "FX80.PRN"
    IF PRINTER$ = "C-ITOH" THEN prnfile$ = "CITOH.PRN"
    IF PRINTER$ = "HPLJII" THEN prnfile$ = "HPLJII.PRN"
    IF PRINTER$ = "" THEN prnfile$ = "AMPRINT.DAT"
    OPEN prnfile$ FOR INPUT AS #1
    INPUT #1, PRINTER$, ESC$, INIT.PTR$, SET.TABS$, condensed.on$, condensed.off$, bold.on$, bold.off$, elongate.on$, elongate.off$, underline.on$, underline.off$, HT$, TAB.STR$
    CLOSE #1
    TAB.STR$ = SET.TABS$
    FOR L% = 1 TO LEN(SET.TABS$)
        I = INSTR(SET.TABS$, "/")
        IF I THEN MID$(SET.TABS$, I) = ","
    NEXT L%

    RETURN

prn.trap:
    CLS
    center 12, "Printer Files Not Found"
    center 13, "Check for .PRN Files"
    CALL delay(2)
    RETURN

build:
    RETURN
custprncodes:
    CLS
LABEL$ = "Custom code entry"
GOSUB read.prnfile
CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)
overlay3:
    LOCATE 6, 5: PRINT "Printer Name  :"; PRINTER$;
    LOCATE 7, 5: PRINT "Escape Code   :"; ESC$;
    LOCATE 8, 5: PRINT "Initialize    :"; INIT.PTR$;
    LOCATE 9, 5: PRINT "Set Tabs      :"; SET.TABS$;
    LOCATE 10, 5: PRINT "Condensed On  :"; condensed.on$;
    LOCATE 11, 5: PRINT "Condensed Off :"; condensed.off$;
    LOCATE 12, 5: PRINT "Bold On       :"; bold.on$;
    LOCATE 13, 5: PRINT "Bold Off      :"; bold.off$;
    LOCATE 14, 5: PRINT "Elongate On   :"; elongate.on$;
    LOCATE 15, 5: PRINT "Elongate Off  :"; elongate.off$;
    LOCATE 16, 5: PRINT "Underline On  :"; underline.on$;
    LOCATE 17, 5: PRINT "Underline Off :"; underline.off$;
    LOCATE 18, 5: PRINT "Horizontal Tab:"; HT$;
    LOCATE 19, 5: PRINT "Tab String    :"; TAB.STR$
'center 24, RTRIM$(SET.TABS$) + RTRIM$(TAB.STR$)

bac:
    a$ = "ESCape to exit or press Any Key to Edit": CALL center(23, a$)

    a$ = INKEY$: IF a$ = "" THEN GOTO bac ELSE a = ASC(a$)
    IF a = 27 THEN RETURN
    GOSUB prnfile.input: RETURN
prnfile.input:
    a$ = "WRITE NEW PRINTER COMMANDS"
    CALL center(2, a$)
    FL = 55: J2 = 6: item2% = J2 - 5

getiton2:

         LOCATE J2, 20
         QX = POS(0): QY = CSRLIN
         FOR x = QX TO QX + FL
        LETTER$ = CHR$(SCREEN(QY, x))
        PROMPT$ = PROMPT$ + LETTER$
         NEXT x
        item2% = J2 - 5
         PRI$(item2%) = PROMPT$
         LOCATE J2, 20
         GOSUB joekey

         IF NOT MOVE.IT THEN GOTO chngit2

    IF KY = UP.CURSOR THEN GOTO uparrow2
    IF KY = DN.CURSOR THEN GOTO dnarrow2
    IF KY = PG.UP THEN J2 = 6: GOSUB saveasis2: GOTO getiton2
    IF KY = PG.DN THEN J2 = 19: GOSUB saveasis2: GOTO getiton2
    IF KY = ESC THEN nochange = 1: RETURN

chngit2: IF in$ <> "" THEN PRI$(item2%) = in$ ELSE PRI$(item2%) = PROMPT$
    IF J2 < 19 THEN J2 = J2 + 1:  GOTO getiton2
    GOSUB write.prnfile: RETURN

uparrow2:

    J2 = J2 + (J2 > 6): GOTO getiton2

dnarrow2:

    J2 = J2 - (J2 < 19): GOTO getiton2

saveasis2:
    LETTER$ = "": item2% = 1
    FOR v2 = 6 TO 19
        PRI$(item2%) = ""
        LOCATE v2, 20
        QX = POS(0): QY = CSRLIN

        FL = 55
            FOR x = QX TO QX + FL
                LETTER$ = CHR$(SCREEN(QY, x))
                PRI$(item2%) = PRI$(item2%) + LETTER$
            NEXT x
            LETTER$ = ""
    item2% = item2% + 1
    NEXT v2

    RETURN



105 '
write.prnfile:

    PRINTER$ = RTRIM$(PRI$(1))
    ESC$ = RTRIM$(PRI$(2))
    INIT.PTR$ = RTRIM$(PRI$(3))
    SET.TABS$ = RTRIM$(PRI$(4))
    condensed.on$ = RTRIM$(PRI$(5))
    condensed.off$ = RTRIM$(PRI$(6))
    bold.on$ = RTRIM$(PRI$(7))
    bold.off$ = RTRIM$(PRI$(8))
    elongate.on$ = RTRIM$(PRI$(9))
    elongate.off$ = RTRIM$(PRI$(10))
    underline.on$ = RTRIM$(PRI$(11))
    underline.off$ = RTRIM$(PRI$(12))
    HT$ = RTRIM$(PRI$(13))
    TAB.STR$ = RTRIM$(PRI$(14))

    OPEN prnfile$ FOR OUTPUT AS #1
    WRITE #1, PRINTER$, ESC$, INIT.PTR$, SET.TABS$, condensed.on$, condensed.off$, bold.on$, bold.off$, elongate.on$, elongate.off$, underline.on$, underline.off$, HT$, TAB.STR$
    CLOSE #1
RETURN
new.prnfile:
    GOSUB prnfile.input: GOSUB write.prnfile: GOSUB custprncodes: RETURN

110 '
treatment.code:
    LABEL$ = "Edit Treatment Codes"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)
    COLOR bc%, fc%
    LOCATE 5, 6: PRINT " # | CODE ID | PROCEDURE ";
    LOCATE 5, 45: PRINT " # | CODE ID | PROCEDURE ";
    COLOR fc%, bc%

code.disp:
    v = 7: COLOR fc%, bc%
    FOR c = 1 TO 12
        LOCATE v, 7: PRINT c; "   "; AC$(c); "   "; TC$(c);
        v = v + 1
    NEXT c
    v = 7
    FOR c = 13 TO 25
        LOCATE v, 46: PRINT c; "   "; AC$(c); "   "; TC$(c);
        v = v + 1
    NEXT c
    a$ = "Edit Treatment Codes Y-N": center 23, a$
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN RETURN
    IF KY$ = "Y" THEN GOSUB edit.treatcodes: RETURN

edit.treatcodes:
    GOSUB read.tc.ovl: COLOR fc%, bc%
    POOF$ = STRING$(55, 32): center 12, POOF$: center 23, POOF$
    CALL makewindow(10, 10, 70, 14, "Edit Codes", 1, 3, bc%, fc%, page%)
    COLOR bc%, fc%
    LOCATE 12, 12: INPUT "Enter Treatment Code Number "; tcn%
    IF tcn% < 1 OR tcn% > 25 THEN SOUND 100, 2: GOTO treatment.code
    center 12, POOF$
    center 14, "Currently = " + AC$(tcn%) + " " + TC$(tcn%)
    LOCATE 12, 12: INPUT "Enter NEW Letter Code I.D. "; AC$
    IF AC$ = "" THEN GOTO treatment.code
    AC$ = UCASE$(AC$)
    aclen% = LEN(AC$)
    IF aclen% > 3 THEN AC$ = LEFT$(AC$, 3)
    AC$(tcn%) = AC$
    center 12, POOF$
    LOCATE 12, 12: INPUT "Enter NEW Procedure "; TC$
    IF TC$ = "" THEN GOTO treatment.code
    TC$ = LCASE$(TC$)
    tclen% = LEN(TC$)
    IF tclen% > 10 THEN TC$ = LEFT$(TC$, 10)
    TC$ = "(" + TC$ + ")"
    TC$(tcn%) = TC$
    LABEL$ = "Edit Treatment Codes"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, 0, fc%, bc%, page%)
    COLOR bc%, fc%
    LOCATE 5, 6: PRINT " # | CODE ID | PROCEDURE ";
    LOCATE 5, 45: PRINT " # | CODE ID | PROCEDURE ";
    COLOR fc%, bc%
    v = 7
    FOR c = 1 TO 12
        LOCATE v, 7: PRINT c; "   "; AC$(c); "   "; TC$(c);
        v = v + 1
    NEXT c
    v = 7
    FOR c = 13 TO 25
        LOCATE v, 46: PRINT c; "   "; AC$(c); "   "; TC$(c);
        v = v + 1
    NEXT c

write.tc.ovl:
         tcovl$ = "TC.OVL"
         OPEN tcovl$ FOR OUTPUT AS #1


         FOR L% = 1 TO 25
        WRITE #1, AC$(L%), TC$(L%)
         NEXT L%
         CLOSE #1


    center 23, POOF$
    center 23, "Another Y-N"
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "Y" THEN GOTO edit.treatcodes
    COLOR fc%, bc%
    RETURN

read.tc.ovl:
         tcovl$ = "TC.OVL"
         OPEN tcovl$ FOR INPUT AS #1
         FOR L% = 1 TO 25
        INPUT #1, AC$(L%), TC$(L%)
         NEXT L%
         CLOSE #1
         RETURN

tcovl.trap:
    CLS
    center 12, "Treatment Code File TC.OVL Not Found"
    CALL delay(1)
    center 13, "Creating New TC.OVL File Now"
         tcovl$ = "TC.OVL"
         OPEN tcovl$ FOR OUTPUT AS #1
         FOR L% = 1 TO 25
        WRITE #1, AC$(L%), TC$(L%)
         NEXT L%
         CLOSE #1

    GOTO edit.treatcodes

150 '
recall.code:
    LABEL$ = "Edit Recall Codes"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)
    COLOR bc%, fc%
    LOCATE 6, 6: PRINT " # | CODE ID | DESCRIPTION ";
    LOCATE 6, 45: PRINT " # | CODE ID | DESCRIPTION ";
    COLOR fc%, bc%

rccode.disp:
    v = 8: COLOR fc%, bc%
    FOR c = 1 TO 12
        LOCATE v, 7: PRINT c; "   "; RCC$(c); "   "; RC$(c);
        v = v + 1
    NEXT c
    v = 8
    FOR c = 13 TO 24
        LOCATE v, 46: PRINT c; "   "; RCC$(c); "   "; RC$(c);
        v = v + 1
    NEXT c
    a$ = "Edit Recall Codes Y-N": center 23, a$
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN RETURN
    IF KY$ = "Y" THEN GOSUB edit.rccodes: RETURN

edit.rccodes:
    GOSUB read.rc.ovl: COLOR fc%, bc%
    POOF$ = STRING$(55, 32): center 12, POOF$: center 23, POOF$
    CALL makewindow(10, 10, 70, 14, "Edit Codes", 1, 3, bc%, fc%, page%)
    COLOR bc%, fc%
    LOCATE 12, 12: INPUT "Enter Recall Code Number "; tcn%
    IF tcn% < 1 OR tcn% > 24 THEN SOUND 100, 2: GOTO recall.code
    center 12, POOF$
    center 14, "Currently = " + RCC$(tcn%) + " " + RC$(tcn%)
    LOCATE 12, 12: INPUT "Enter NEW Letter Code I.D. "; RCC$
    IF RCC$ = "" THEN GOTO recall.code
    RCC$ = UCASE$(RCC$)
    rclen% = LEN(RCC$)
    IF rclen% > 3 THEN RCC$ = LEFT$(RCC$, 3)
    RCC$(tcn%) = RCC$
    center 12, POOF$
    LOCATE 12, 12: INPUT "Enter NEW Description "; RC$
    IF RC$ = "" THEN GOTO recall.code
    RC$ = UCASE$(RC$)
    rclen% = LEN(RC$)
    IF rclen% > 15 THEN RC$ = LEFT$(RC$, 15)
    RC$(tcn%) = RC$
    LABEL$ = "Edit Recall Codes"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, 0, fc%, bc%, page%)
    COLOR bc%, fc%
    LOCATE 6, 6: PRINT " # | CODE ID | DESCRIPTION ";
    LOCATE 6, 45: PRINT " # | CODE ID | DESCRIPTION ";
    COLOR fc%, bc%
    v = 8
    FOR c = 1 TO 12
        LOCATE v, 7: PRINT c; "   "; RCC$(c); "   "; RC$(c);
        v = v + 1
    NEXT c
    v = 8
    FOR c = 13 TO 24
        LOCATE v, 46: PRINT c; "   "; RCC$(c); "   "; RC$(c);
        v = v + 1
    NEXT c

write.rc.ovl:
         rcovl$ = "RC.OVL"
         OPEN rcovl$ FOR OUTPUT AS #1
         FOR L% = 1 TO 24
        WRITE #1, RCC$(L%), RC$(L%)
         NEXT L%
         CLOSE #1


    center 23, POOF$
    center 23, "Another Y-N"
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "Y" THEN GOTO edit.rccodes
    COLOR fc%, bc%
    RETURN

read.rc.ovl:
         rcovl$ = "RC.OVL"
         OPEN rcovl$ FOR INPUT AS #1
         FOR L% = 1 TO 24
        INPUT #1, RCC$(L%), RC$(L%)
         NEXT L%
         CLOSE #1
         RETURN

rcovl.trap:
    CLS
    center 12, "Recall Code File RC.OVL Not Found"
    CALL delay(1)
    center 13, "Creating New RC.OVL File Now"
         rcovl$ = "RC.OVL"
         OPEN rcovl$ FOR OUTPUT AS #1
         FOR L% = 1 TO 24
        WRITE #1, RCC$(L%), RC$(L%)
         NEXT L%
         CLOSE #1

    GOTO edit.rccodes


200 'todate
201 '



     TODAY.DATE$ = DATE$: TODAY.MONTH% = VAL(LEFT$(TODAY.DATE$, 2))
     MONTH.TP% = TODAY.MONTH%
     TODAY.DAY% = VAL(MID$(TODAY.DATE$, 4, 2))
     DAY.TP$ = STR$(TODAY.DAY%): DAY.TP% = TODAY.DAY%
     TODAY.YEAR% = VAL(RIGHT$(TODAY.DATE$, 2))
     YEAR.TP% = TODAY.YEAR%
     YEAR.TP$ = STR$(YEAR.TP%)
     GOSUB 30350 'Pull BASIC LIB for run
     TODAY.DATE.STR$ = DATE.STR.TP$
     TODAY.DC% = DC: TODAY.MAX.DAYS% = MAX.DAYS%
     RETURN

300 'Center
     CALL center(v, a$): RETURN
350 'Option
    LOCATE 12, 30: COLOR 0, 14: PRINT "OPTION NOT AVAILABLE"; : COLOR fc%, bc%: FOR L = 1 TO 1500: NEXT L: LOCATE 25, 1: PRINT CLR$; : RETURN
385 '
390 'Numeric
395 '
400 num.err% = 0: FOR LOUP = 1 TO LEN(IN.STRING$): a = ASC(MID$(IN.STRING$, LOUP, 1)): IF a < 48 OR a > 57 THEN num.err% = 1: RETURN
402 NEXT LOUP: IN.NUM% = VAL(LEFT$(IN.STRING$, 4)): RETURN
403 '
490 'String

IN.STRING$ = "": in.line% = CSRLIN: IN.COLUMN% = POS(0)
510 COLOR fc% + 16, bc%: PRINT CHR$(16); : COLOR fc%, bc%
520 a$ = INKEY$: IF a$ = "" THEN 520 ELSE a = ASC(a$)
    IF a = 27 THEN 600
    IF a = 8 THEN GOSUB 640: GOTO 520
    IF a = 13 THEN LOCATE CSRLIN, POS(0) - 1: COLOR fc%, bc%: PRINT " "; : RETURN
    IF a < 32 OR a > 126 THEN BEEP: GOTO 520
    IF POS(0) - 1 THEN LOCATE CSRLIN, POS(0) - 1
    PRINT a$; : IN.STRING$ = IN.STRING$ + a$: GOTO 510
600 '[ESC] KEY
610 IF IN.STRING$ = "" THEN LOCATE CSRLIN, POS(0) - 1: PRINT "  "; : RETURN
620 LOCATE in.line%, IN.COLUMN%: PRINT SPACE$(LEN(IN.STRING$) + 1); : LOCATE in.line%, IN.COLUMN%: IN.STRING$ = "": GOTO 510
640 ' BACKSPACE
650 IF IN.STRING$ = "" THEN BEEP: RETURN
660 IN.STRING$ = LEFT$(IN.STRING$, LEN(IN.STRING$) - 1): LOCATE CSRLIN, POS(0) - 2: PRINT "  "; : LOCATE CSRLIN, POS(0) - 2: COLOR fc% + 16, bc%: PRINT CHR$(16); : COLOR fc%, bc%: RETURN

tyme:
700 CALL tyme
    RETURN

1000 'INKEY
1010 a$ = INKEY$: IF a$ = "" THEN 1010 ELSE a = ASC(a$): RETURN

4000 '
main.menu:
GOSUB 200
FC2% = fc%: BC2% = bc%
Second.title$ = "SETUP AND MAINTENANCE"
bottom.msg$ = ver$

'
first.menu:
    m$(1) = "SET UP AND MAINTENANCE"
    m$(2) = "FILE / DISK UTILITIES"
    m$(3) = "PRINTER INSTALLATION"
    m$(4) = "APPOINTMENTS MODULE"
    m$(5) = "ACCOUNTS RECEIVABLE"
    m$(6) = "EXIT TO DOS"

4001 ' Redraw
np = 6
COLOR fc%, bc%
CLS
LABEL$ = "Main Menu"
CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, 4, 2, fc%, bc%, page%)
CALL center(2, "QBUDDY SYSTEMS") 'Prints the first menu title
CALL center(3, Second.title$)

CALL center(23, bottom.msg$)

CALL getcrt(colordisp%)
IF colordisp% THEN LOCATE 24, 8: PRINT "";  ELSE LOCATE 24, 9: PRINT "Mono";
CALL getdosv(maj%, min%)
CALL getkbd(INSERT%, capslock%, numlocl%, scrolock%)
IF capslock% THEN LOCATE 24, 56: PRINT "CAPS";
IF numlocl% THEN LOCATE 24, 50: PRINT "NUM";
IF scrolock% THEN LOCATE 25, 56: PRINT "SCRL";
fc = fc%: bc = bc%
CALL menu(fc, bc, bc, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)
IF INSERT% THEN LOCATE 25, 50: PRINT "INS";

CLS
a = CH
     IF a = 1 THEN GOSUB set.up: GOTO main.menu
     IF a = 2 THEN GOSUB file.utilities: GOTO main.menu
     IF a = 3 THEN GOSUB printer.install: GOTO main.menu
     IF a = 4 THEN GOTO main.menu
     IF a = 5 THEN GOTO main.menu
     IF a = 6 THEN RETURN

file.utilities:
    LABEL$ = " Utilities ": POOF$ = STRING$(60, 32): center 23, POOF$
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, 4, 2, fc%, bc%, page%)
    center 2, "QBUDDY SYSTEMS"
    m$(1) = "SCAN DIRECTORY"
    m$(2) = "READ TEXT FILES"
    m$(3) = "COPY FILES"
    m$(4) = "BACK UP DATA FILES"
    m$(5) = "MAIN MENU"
np = 5
    CALL menu(fc, bc, bc, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)


a = CH

    IF a = 1 THEN GOSUB dirscan: GOTO file.utilities
    IF a = 2 THEN GOSUB readafile: GOTO file.utilities
    IF a = 3 THEN GOSUB copy.files: GOTO file.utilities
    IF a = 4 THEN GOSUB backups: GOTO file.utilities
    IF a = 5 THEN RETURN

copy.files:
    CLS : LABEL$ = " Copy Files ": SOURCE$ = "": DEST$ = "": POOF$ = STRING$(55, 32)
    CALL makewindow(10, 10, 70, 14, LABEL$, 1, 3, bc%, fc%, page%)
    COLOR bc%, fc%
    center 12, POOF$: center 13, POOF$
    LOCATE 12, 12: INPUT "Enter path and name of the source file "; SOURCE$
    IF SOURCE$ = "" THEN COLOR fc%, bc%: RETURN
    SOURCE$ = UCASE$(SOURCE$)
    FIL$ = SOURCE$ + CHR$(0)
    CALL findfirstf(FIL$, 0, ERCD%)
    IF ERCD% THEN GOTO no.source ELSE
pathfinder:
    center 13, POOF$
    LOCATE 13, 12: INPUT "Enter path and name of destination file "; DEST$
    IF DEST$ = "" THEN RETURN
    DEST$ = UCASE$(DEST$): DRV$ = LEFT$(DEST$, 1) + ":"
    a$ = LEFT$(DRV$, 1): a = ASC(a$)
    IF a < 65 OR a > 68 THEN GOTO invalid.drv
    CALL stripblanks(DRV$, 3, slen%)
    DRV$ = LEFT$(DRV$, slen%)
    CALL drvspace(DRV$, a%, b%, c%)
    free# = CDBL(a%) * CDBL(b%) * CDBL(c%)
    a$ = "Free Space on Destination Drive " + DRV$ + " is" + STR$(free#) + " bytes."
    COLOR bc%, fc%: center 10, a$: COLOR fc%, bc%
    FIL$ = DEST$ + CHR$(0)
    CALL exist(FIL$, filexists%)
    IF filexists% THEN GOTO overwrite
    center 12, POOF$
    center 13, POOF$
    center 12, "Copy " + SOURCE$ + " to " + DEST$
    center 14, POOF$
    center 14, "Correct ? (Y-N-E-xit)"
    ALLOW$ = "YNE": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN GOTO copy.files
    IF KY$ = "E" THEN COLOR fc%, bc%: RETURN
    IF KY$ = "Y" THEN GOTO copy.it

no.source:
    center 11, "Source File Does Not Exist"
    CALL delay(2)
    center 11, POOF$
    GOTO copy.files
overwrite:
    COLOR bc%, fc%
    center 14, POOF$
    COLOR fc%, bc%: center 14, "File Exists...Overwrite (Y-N)": COLOR bc%, fc%
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN GOTO pathfinder
    IF KY$ = "Y" THEN GOTO copy.it

copy.it:

    SOURCE$ = SOURCE$ + CHR$(0): DEST$ = DEST$ + CHR$(0)
    ERCD% = 0
    CALL copyfile(SOURCE$, DEST$, ERCD%)
    IF ERCD% THEN GOTO fail.copy
    COLOR fc%, bc%
    RETURN
fail.copy:
    center 23, "The copy failed. Try again."
    CALL delay(1)
    GOTO copy.files

invalid.drv:
    SOUND 100, 2
    center 23, "You entered an invalid drive specification"
    center 24, "Acceptable drives are A-B-C-D"
    CALL delay(3)
    center 23, POOF$: center 24, POOF$
    GOTO pathfinder


backups:
LABEL$ = " Archival Backups APPOINTMENT DATA FILES "
CALL makewindow(10, 10, 70, 14, " BACK UP ", 1, 3, bc%, fc%, page%)
CALL center(2, "QBUDDY SYSTEMS"): POOF$ = STRING$(70, 32)
    POOF$ = STRING$(50, 32)
    center 5, "This command is exactly like the DOS COPY command."
    center 6, "It will copy OVER existing files and destroy them."
    center 7, "The Files are compressed to conserve disk space."
COLOR fc% + 16, bc%: center 17, "*** CAUTION ***": COLOR fc%, bc%: center 18, "APPOINTMENT BACKUP FLOPPY DISK"
    center 19, "Be sure you place the correct floppy disk in drive A"
    center 20, "and close the door."
    center 21, "Choose N(o) to EXIT"
    COLOR bc%, fc%
    center 12, POOF$: center 13, POOF$
    center 12, "Backup APPOINTMENT files to Drive A"
    center 14, "(Y-N)"
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "Y" THEN GOSUB aptfile.backup: COLOR fc%, bc%: RETURN
    IF KY$ = "N" THEN GOSUB patbak: COLOR fc%, bc%: RETURN

aptfile.backup:
    SOURCE$ = APT.PATH$ + "*.*": DEST$ = "A:\"
    DOS.CMD$ = "COPY " + SOURCE$ + " " + DEST$
    COLOR 7, 0
    CLS : LOCATE 1, 1
    PRINT "SHELL TO DOS - Copying APPOINTMENT files to Drive A";
    LOCATE 3, 1
    SHELL DOS.CMD$
    COLOR fc%, bc%: CLS
'RETURN
patbak:
LABEL$ = " Archival Backups CLIENT DATA FILES "
CALL makewindow(10, 10, 70, 14, " BACK UP ", 1, 3, bc%, fc%, page%)
CALL center(2, "QBUDDY SYSTEMS")
COLOR fc% + 16, bc%: center 17, "*** CAUTION ***": COLOR fc%, bc%: center 18, "CLIENT FILE BACKUP FLOPPY DISK"
    SOUND 100, 1
    COLOR bc%, fc%
    center 12, POOF$: center 13, POOF$
    center 12, "Backup CLIENT files to Drive A"
    center 14, "(Y-N)"
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "Y" THEN GOSUB patfile.backup: RETURN
    IF KY$ = "N" THEN COLOR fc%, bc%: RETURN

patfile.backup:
    SOURCE$ = PAT.PATH$ + "*.*": DEST$ = "A:\"
    DOS.CMD$ = "COPY " + SOURCE$ + " " + DEST$
    COLOR 7, 0
    CLS : LOCATE 1, 1
    PRINT "SHELL TO DOS - Copying CLIENT files to Drive A";
    LOCATE 3, 1
    SHELL DOS.CMD$
    COLOR fc%, bc%
    RETURN

dirscan:
    faccess% = 2: fmode% = 2: handle% = 1
    CALL infile(PAT.PATH$, APT.PATH$, inflg%, FILENAME$, fc%, bc%, SYS.PATH$, ERCD%, handle%, faccess%, fmode%, SUB.PATH$)
    a$ = STRING$(75, 32): center 23, a$
    a$ = "Press any key": center 23, a$
    CLS : RETURN


readafile:
    LABEL$ = "Read Text File"
    CALL makewindow(10, 10, 70, 14, LABEL$, 1, 3, bc%, fc%, page%)
    COLOR bc%, fc%
    LOCATE 12, 12: INPUT "Enter complete path/filespec "; FILENAME$
    IF FILENAME$ = "" THEN COLOR fc%, bc%: RETURN
    FILENAME$ = UCASE$(FILENAME$)
    FIL$ = FILENAME$ + CHR$(0)
    CALL exist(FIL$, exists%)
    IF exists% THEN GOTO read.it
trap.it:
    POOF$ = STRING$(55, 32): SOUND 100, 2: COLOR bc%, fc%
    center 12, POOF$
    center 10, "Be Sure To Enter COMPLETE path (C:\FileName.Ext)"
    center 12, "This File Not Found " + STRING$(3, 247) + CHR$(16) + " " + FILENAME$
    center 14, "Try Again Y-N"
    ALLOW$ = "YN": KY$ = "x"
    CALL getkey(ALLOW$, KY$)
    IF KY$ = "Y" THEN COLOR fc%, bc%: GOTO readafile
    COLOR fc%, bc%
    RETURN


read.it:
    COLOR fc%, bc%
    CLS : FILENAME$ = UCASE$(FILENAME$)
    center 2, " Reading -> " + FILENAME$



    v = 6
    OPEN FILENAME$ FOR INPUT AS #1
        WHILE NOT EOF(1)
            LINE INPUT #1, BUFFER$
            LOCATE v, 6: PRINT BUFFER$
            v = v + 1
            IF v >= 18 THEN GOSUB hold.it
        WEND
    CLOSE #1
view.it:
    a$ = "Press a key to continue...": center 23, a$
    a$ = INKEY$: IF a$ = "" THEN GOTO view.it

    RETURN


hold.it:
    v = 6
'KY$ = INKEY$
'IF KY$ = CHR$(19) THEN WHILE INKEY$ = "": WEND  '  handle CTRL-S for pause
    a$ = "Press a key for next page...": center 23, a$
    a$ = INKEY$: IF a$ = "" THEN GOTO hold.it ELSE CLS : RETURN

close.it:
    a$ = "       Closing " + FILENAME$ + "          ": center 23, a$
    a$ = INKEY$: IF a$ = "" THEN GOTO close.it
    CLOSE #1
    RETURN


set.up:
5200 'setup
    VIEW PRINT 1 TO 25: FC2% = fc%: BC2% = bc%
        m$(1) = "ALTER CONFIGURATION FILE"
        m$(2) = "DELETE OLD APPOINTMENT FILES"
        m$(3) = "FORMAT ACCOUNTING FILE DISK"
        m$(4) = "FORMAT NEW CLIENT FILE DISK"
        m$(5) = "EDIT TREATMENT CODES"
        m$(6) = "EDIT RECALL CODES"
        m$(7) = "EXIT TO MAIN MENU"
5201 ' Redraw
np = 7
COLOR fc%, bc%, bc%
inflg% = 0
CLS
LABEL$ = " Set Up and Maintenance "
CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)
CALL center(2, "QBUDDY SYSTEMS")
fc = FC2%: bc = BC2%
CALL menu(fc, bc, bc, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)
CLS
a = CH
     IF a = 1 THEN GOSUB 40: GOSUB read.parm: GOTO 5200
     IF a = 4 THEN GOSUB am8format: GOTO 5200
    IF a = 3 THEN GOSUB amacformat: GOTO 5200
     IF a = 2 THEN GOSUB delapt: GOTO 5200
     IF a = 5 THEN GOSUB treatment.code: GOTO 5200
     IF a = 6 THEN GOSUB recall.code: GOTO 5200
     IF a = 7 THEN RETURN

WARN:

LABEL$ = "Formatting New File Disk or Directory"
CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)

    a$ = "Floppy disks must first be formatted using MS-DOS.": CALL center(6, a$)
    a$ = "CAUTION: This command will erase existing data.": CALL center(7, a$)
    a$ = "Directory paths are CRITICAL!": CALL center(8, a$)
    a$ = STRING$(60, 196): center 10, a$
    a$ = "Format commands are used to initialize NEW data disks.": center 12, a$
    a$ = "If you use the same directory path as existing data": center 13, a$
    a$ = "it will be destroyed. Please enter information carefully.": center 14, a$
    a$ = "Only CLIENT DATA is subject to LOSS due to new indexing.": center 16, a$
    a$ = "No other files are in jeopardy.": center 17, a$
    a$ = "Press any Key - An EXIT is allowed in next step": center 24, a$
warning: a$ = INKEY$: IF a$ = "" GOTO warning ELSE a = ASC(a$)
    a$ = STRING$(70, 32): center 24, a$
RETURN

am8format:
    GOSUB WARN

    LABEL$ = "Format New CLIENT File Disk/Directory"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)

usrprmt:
a$ = STRING$(70, 32): SOUND 100, 3: center 10, a$
    a$ = "CREATE New CLIENT INDEX FILES": center 6, a$
    a$ = "Acceptable examples are... A:\  B:\   C:\PAT\   D:\CLIENT\": center 7, a$
    a$ = "Use a \ (backslash) following the last path entry": center 8, a$
    a$ = "Press ESC(ape) to EXIT.": center 23, a$
    LOCATE 10, 5: PRINT "Enter number of total records "; : GOSUB 490
    IF IN.STRING$ = "" THEN RETURN
    GOSUB 390
    IF num.err% = 1 THEN GOTO usrprmt ELSE
    IN.NUM% = maxrecords%
    LOCATE 10, 5: PRINT STRING$(40, 32);
    LOCATE 12, 5: PRINT "Enter complete path name for CLIENT files directory "; : GOSUB 490
    LOCATE 12, 5: PRINT STRING$(68, 32): IF IN.STRING$ = "" THEN RETURN
    F$ = IN.STRING$ + "RECORD.IDX": LOCATE 14, 10: COLOR bc%, fc%: PRINT "CREATING "; F$;
    COLOR fc%, bc%
     OPEN "R", #1, F$, 2
     FIELD #1, 2 AS NEXT.REC$: LSET NEXT.REC$ = MKI$(1): PUT #1, 1
FOR L% = 2 TO maxrecords%
     LSET NEXT.REC$ = MKI$(0): PUT #1, L%
NEXT L%
     CLOSE #1
     LOCATE 14, 10: PRINT "CREATING INDEX FILE  .IDX"; SPC(20);
FOR L% = 65 TO 90
     LOCATE 14, 30: PRINT CHR$(L%); : index.file$ = IN.STRING$ + CHR$(L%) + ".IDX": OPEN "R", #1, index.file$, 2: FIELD #1, 2 AS REC.PTR$
     LSET REC.PTR$ = MKI$(1): PUT #1, 1: CLOSE #1
NEXT L%: RETURN
IF ERL = usrprmt THEN RESUME am8format
5500 'CLEAR HELP
5505 COLOR 15, 2: FOR v = 22 TO 24
     LOCATE v, 5: PRINT SPC(68);
     NEXT v: RETURN'Clear Help


6100 'READ PAT REC
     F$ = PAT.PATH$ + "RECORD.IDX": BLANK.REC% = 0: OPEN "R", #5, F$, 2: FIELD #5, 2 AS RI.LAST.REC$: GET #5, CLIENT.NUM%: RI.LAST.REC% = CVI(RI.LAST.REC$): CLOSE #5: IF RI.LAST.REC% = 0 THEN BLANK.REC% = 1: RETURN
     F$ = PAT.PATH$ + "CLIENT.APT": OPEN "R", #1, F$, 84
     FIELD #1, 20 AS LAST.NAME$, 20 AS FIRST.NAME$, 17 AS NEXT.APT$, 17 AS LAST.APT$, 10 AS NOTES$: GET #1, RI.LAST.REC%
     PI$(1) = LAST.NAME$: PI$(2) = FIRST.NAME$: PI$(5) = NOTES$: PI$(3) = NEXT.APT$: PI$(4) = LAST.APT$
     CLOSE #1
     RETURN

6540 'WRITE PAT REC
6550 '
     F$ = PAT.PATH$ + "CLIENT.APT": OPEN "R", #1, F$, 84
     FIELD #1, 20 AS LAST.NAME$, 20 AS FIRST.NAME$, 17 AS NEXT.APT$, 17 AS LAST.APT$, 10 AS NOTES$: GET #1, RI.LAST.REC%
     LSET LAST.NAME$ = PI$(1): LSET FIRST.NAME$ = PI$(2)
     LSET NEXT.APT$ = PI$(3): LSET LAST.APT$ = PI$(4): LSET NOTES$ = PI$(5)
     PUT #1, RI.LAST.REC%
     CLOSE #1
     RETURN
amacformat:
    GOSUB WARN
    LABEL$ = "Format New ACCOUNTING Disk/Directory"
    CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, page%)

    a$ = "CREATE AMAC/CLIENT INDEX FILES": center 6, a$
    a$ = "Acceptable examples are... A:\  B:\   C:\Client\   D:\Client\": center 7, a$
    a$ = "Use a \ (backslash) following the last path entry": center 8, a$
    a$ = "Press ESC(ape) to EXIT.": center 23, a$
entra:

    a$ = STRING$(70, 32): SOUND 100, 3: center 10, a$
    LOCATE 10, 5: PRINT "Enter number of total records "; : GOSUB 490
    IF IN.STRING$ = "" THEN RETURN
    GOSUB 390
    IF num.err% = 1 THEN GOTO entra ELSE
    IN.NUM% = maxrecords%
    LOCATE 10, 5: PRINT STRING$(40, 32);
    LOCATE 12, 5: PRINT "Enter complete path name for Client files directory "; : GOSUB 490
    LOCATE 12, 5: PRINT STRING$(68, 32): IF IN.STRING$ = "" THEN RETURN
    F$ = IN.STRING$ + "RECORD.IDX": LOCATE 14, 10: COLOR bc%, fc%: PRINT "CREATING "; F$;
    COLOR fc%, bc%
     OPEN "R", #1, F$, 2
     FIELD #1, 2 AS NEXT.REC$: LSET NEXT.REC$ = MKI$(1): PUT #1, 1
FOR L% = 2 TO maxrecords%
     LSET NEXT.REC$ = MKI$(0): PUT #1, L%
NEXT L%
     CLOSE #1
     LOCATE 14, 10: PRINT "CREATING INDEX FILE  .IDX"; SPC(20);
FOR L% = 65 TO 90
     LOCATE 14, 30: PRINT CHR$(L%); : index.file$ = IN.STRING$ + CHR$(L%) + ".IDX": OPEN "R", #1, index.file$, 2: FIELD #1, 2 AS REC.PTR$
     LSET REC.PTR$ = MKI$(1): PUT #1, 1: CLOSE #1
NEXT L%: RETURN
     OPEN "R", #1, F$, 2
     FIELD #1, 2 AS NEXT.REC$: LSET NEXT.REC$ = MKI$(1): PUT #1, 1
FOR L% = 2 TO maxrecords%
     LSET NEXT.REC$ = MKI$(0): PUT #1, L%
NEXT L%
     CLOSE #1
'Dummy Record
    API$(1) = "Angelo"
    API$(2) = "Michael Genius"
    API$(3) = "123 Champions Dr"
    API$(4) = "Houston"
    API$(5) = "Tx"
    API$(6) = "77055-5555"
    API$(7) = "[phone]"
    API$(8) = "[phone]"
    API$(9) = "1650.00"
    API$(10) = " 123.65"
    API$(11) = "1526.35"
    API$(12) = "  45.00"
    API$(13) = "06-15-1988"
    API$(14) = "Will pay 9-15  "
    API$(15) = "06-25-1988"
    API$(16) = " 35.00"
    CLIENT.NUM% = 2
GOSUB initrec

WRITECLIENTREC:

     F$ = CLIENT.PATH$ + "CLIENT.APT": OPEN "R", #1, F$, 185
     FIELD #1, 20 AS LAST.NAME$, 20 AS FIRST.NAME$, 20 AS STREET$, 17 AS CITY$, 2 AS STATE$, 10 AS ZIP$, 13 AS TELE1$, 13 AS TELE2$, 7 AS TOTAL$, 7 AS DWNPAY$, 7 AS BAL$, 7 AS MOPMT$, 10 AS DUEDATE$, 15 AS NOTES$, 10 AS PMTDATE$, 7 AS AMTPAID$: _
                                            GET #1, RI.LAST.REC%
     LSET LAST.NAME$ = API$(1)
     LSET FIRST.NAME$ = API$(2)
     LSET STREET$ = API$(3)
     LSET CITY$ = API$(4)
     LSET STATE$ = API$(5)
     LSET ZIP$ = API$(6)
     LSET TELE1$ = API$(7)
     LSET TELE2$ = API$(8)
     LSET TOTAL$ = API$(9)
     LSET DWNPAY$ = API$(10)
     LSET BAL$ = API$(11)
     LSET DUEDATE$ = API$(13)
     LSET MOPMT$ = API$(12)
     LSET NOTES$ = API$(14)
     LSET PMTDATE$ = API$(15)
     LSET AMTPAID$ = API$(16)
     PUT #1, RI.LAST.REC%
     CLOSE #1
     RETURN

initrec:

    F$ = CLIENT.PATH$ + "RECORD.IDX": OPEN "R", #5, F$, 2: FIELD #5, 2 AS RI.LAST.REC$: GET #5, 1: RI.LAST.REC% = CVI(RI.LAST.REC$) + 1: LSET RI.LAST.REC$ = MKI$(RI.LAST.REC%): PUT #5, 1
    LSET RI.LAST.REC$ = MKI$(RI.LAST.REC%): PUT #5, CLIENT.NUM%: CLOSE #5: GOSUB 6540: index.file$ = CLIENT.PATH$ + LEFT$(API$(1), 1) + ".IDX": ADD.REC% = 1
incrementrec:
    OPEN "R", #3, index.file$, 2: FIELD #3, 2 AS AI.LAST.REC$: GET #3, 1: AI.LAST.REC% = CVI(AI.LAST.REC$) + 1: LSET AI.LAST.REC$ = MKI$(AI.LAST.REC%): PUT #3, 2: CLOSE : RETURN

delapt:
    v = 10: h = 30: num.err% = 0: APT.DATE.STR$ = ""
    COLOR fc%, bc%: CLS
    LOCATE 1, 1: PRINT "   Directory "; APT.PATH$; " contains the following Appointment Files.   ";
    LOCATE 4, 1: FILES "" + APT.PATH$ + "A?????.APT"
entre:
    MONTH.TP% = 0: DAY.TP% = 0: YEAR.TP% = 0: LY = 0
    SOUND 100, 2: IN.STRING$ = ""
    LOCATE 23, 66: PRINT SPC(15);
    center 24, "Press ESC to exit"
    LOCATE 23, 18: PRINT "Delete appointments PRIOR to what date? (mmddyy)"; : GOSUB 490
    IF a = 27 THEN RETURN
    center 23, STRING$(78, 32)
    GOSUB 390: IF num.err% THEN GOTO entre
    trap% = LEN(IN.STRING$)
        IF trap% <= 5 OR trap% >= 7 THEN GOTO entre
    MONTH.TP% = VAL(LEFT$(IN.STRING$, 2))
        APT.MO$ = LEFT$(IN.STRING$, 2)
    DAY.TP% = VAL(MID$(IN.STRING$, 3, 2))
        APT.DAY$ = MID$(IN.STRING$, 3, 2)
    YEAR.TP% = VAL(RIGHT$(IN.STRING$, 2))
        APT.YEAR$ = RIGHT$(IN.STRING$, 2)

yousure:

    APT.DATE.STR$ = APT.MO$ + "/" + APT.DAY$ + "/19" + APT.YEAR$
    a$ = "You are about to delete ALL files through " + APT.DATE.STR$
    center 23, a$
    a$ = "Press ESC to cancel or Any Key to continue"
    center 24, a$
    GOSUB 1000
    IF a = 27 THEN RETURN
    a$ = STRING$(70, 32)
    center 22, a$
    center 23, a$
    center 24, a$
calcit: DC = INT(365.25 * YEAR.TP%) + INT(30.56 * MONTH.TP%) + LY + DAY.TP%: DW = 3 + DC - 7 * INT((DC + 2) / 7): MD(2) = 28 + LE
    MAX.DAYS% = MD(MONTH.TP%)
LOCATE 24, 35: PRINT ""
    FOR L% = 5 TO 21: IF SCREEN(L%, 1) <> 65 THEN GOTO notfound
        FOR L1% = 2 TO 56 STEP 18: IF SCREEN(L%, L1%) = 3 THEN RETURN
            T$ = "": FOR L2% = L1% TO L1% + 6: T$ = T$ + CHR$(SCREEN(L%, L2%)): NEXT L2%
            T% = VAL(T$)
            IF T% <= DC THEN GOSUB killit ELSE GOTO notfound
        NEXT L1%
    NEXT L%
notfound:
    IF APT.DATE.STR$ = "" THEN APT.DATE.STR$ = "NO FILES FOUND"
    center 23, STRING$(70, 32)
    center 24, "No files to delete. Press Any Key"
    LOCATE 23, 26: PRINT "Killed files from "; APT.DATE.STR$;
    a$ = INPUT$(1)
    RETURN
listit:

    T$ = APT.PATH$ + "A" + RTRIM$(T$) + ".APT"
    LOCATE v, h: PRINT T$;
    v = v + 1: IF v >= 19 THEN v = 1
    RETURN

29999 'killit
killit:
    LOCATE L%, L1% - 1: PRINT SPC(12);
    T$ = APT.PATH$ + "A" + RTRIM$(T$) + ".APT"
    KILL T$
    RETURN

Calmod:
30000 'Set BASIC Library ON
30002 '
30020 ' SEPARATE MONTH, DAY, AND YEAR FROM IN.STRING$
30030 date.err% = 0: MONTH.TP$ = "": DAY.TP$ = "": YEAR.TP$ = "": DATE.STR$ = ""
30040 '
30050 FOR LP% = 1 TO LEN(IN.STRING$)
30060 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
30070 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN MONTH.TP$ = MONTH.TP$ + CUR.CHR$
30072 NEXT LP%
30080 IF MONTH.TP$ = "" OR LEN(IN.STRING$) - LP% = 0 THEN 30200
30082 IF VAL(MONTH.TP$) > 12 THEN 30200
30090 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
30110 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
30120 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN DAY.TP$ = DAY.TP$ + CUR.CHR$
30125 NEXT LP%
30130 IF DAY.TP$ = "" OR LEN(IN.STRING$) - LP% = 0 THEN 30200
30140 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
30150 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
30160 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN YEAR.TP$ = YEAR.TP$ + CUR.CHR$
30165 NEXT LP%
30170 IF YEAR.TP$ = "" THEN 30200
30180 MONTH.TP% = VAL(MONTH.TP$): DAY.TP% = VAL(DAY.TP$): YEAR.TP% = VAL(YEAR.TP$)
30190 GOSUB 30350: RETURN
30200 date.err% = 1: RETURN
30210 '
30220 'SEPARATE M/Y
30225 '
30230 date.err% = 0: MONTH.TP$ = "": YEAR.TP$ = ""
30240 FOR LP% = 1 TO LEN(IN.STRING$)
30250 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
30260 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN 30262 ELSE 30280
30262 MONTH.TP$ = MONTH.TP$ + CUR.CHR$
30265 NEXT LP%
30280 FOR LP% = LP% + 1 TO LEN(IN.STRING$)
30290 CUR.CHR$ = MID$(IN.STRING$, LP%, 1)
30300 IF CUR.CHR$ >= "0" AND CUR.CHR$ <= "9" THEN 30302 ELSE 30310
30302 YEAR.TP$ = YEAR.TP$ + CUR.CHR$
30305 NEXT LP%
30310 IF YEAR.TP$ = "" THEN 30330
30320 MONTH.TP% = VAL(MONTH.TP$): YEAR.TP% = VAL(YEAR.TP$)
30325 DAY.TP$ = "1": DAY.TP% = 1: DATE.STR$ = MO$(MONTH.TP%) + " - 19" + YEAR.TP$: RETURN
30330 BEEP: date.err% = 1: RETURN
30340 '
30350 'VALID DATE
30351 '
30352 date.err% = 0: LY = 0: IF MONTH.TP% > 2 THEN 30356
30354 LY = 1: LE = 1: IF YEAR.TP% MOD 4 THEN LY = 2: LE = 0
30356 DC = INT(365.25 * YEAR.TP%) + INT(30.56 * MONTH.TP%) + LY + DAY.TP%: DW = 3 + DC - 7 * INT((DC + 2) / 7): MD(2) = 28 + LE: IF MONTH.TP% > 12 THEN 30362
30358  MAX.DAYS% = MD(MONTH.TP%): IF YEAR.TP% = 0 OR DAY.TP% > MAX.DAYS% THEN 30362
30360 DATE.STR.TP$ = MO$(MONTH.TP%) + " " + DAY.TP$ + ", 19" + LTRIM$(YEAR.TP$): RETURN
30362 DW = 8: date.err% = 1: RETURN
40000 'ERRORS
    SELECT CASE ERR
        CASE 4
            endofdata = TRUE
            RESUME NEXT
        CASE 25
            a$ = "Turn Printer On"
            center 12, a$
            CALL delay(2)
            RESUME main.menu

        CASE 27
            a$ = "Printer is out of paper."
            center 12, a$
            CALL delay(2)
            RESUME main.menu

        CASE 52
            a$ = "Path File Access Error Occurred"
            center 12, a$
            CALL delay(2)
            RESUME main.menu

        CASE 71
            CLS
            a$ = "Drive is not ready"
            center 12, a$
            CALL delay(2)
            RESUME main.menu
        CASE 72
            CLS
            a$ = "Disk Media Problem"
            center 12, a$
            CALL delay(2)
            RESUME main.menu

        CASE 75
            CLS
            a$ = "Path File Access Error Occurred"
            center 12, a$
            CALL delay(2)
            RESUME main.menu

        CASE 53
            a$ = "File not found...": center 24, a$
            SOUND 240, 2
            IF ERL = 6550 THEN RESUME notfound
            IF ERL = 110 THEN RESUME tcovl.trap
            IF ERL = 150 THEN RESUME rcovl.trap
            IF ERL = 60 THEN RESUME parm.trap
            IF ERL = 65 THEN RESUME parm.trap
            IF ERL = 100 THEN RESUME prn.trap
            IF ERL = 105 THEN RESUME prn.trap

        CASE ELSE
            CLS
            LOCATE 12, 35: PRINT "USER ERROR "; ERR;
            center 13, "Please Read Documentation and Correct"
            center 15, "You will have to re-start AMSETUP.EXE"
            END
    END SELECT

50000 '
logo:
    COLOR 15, 4: CLS
    LOCATE 5, 1



 PRINT "      ╔══════════════════════════════════════════════════════════════════╗   "
 PRINT "      ║                                                                  ║   "
 PRINT "      ║            █▀▀▀▀█      █               █     █                   ║   "
 PRINT "      ║            █    █  ▄▄  █▄▄▄▄ ▄   ▄ ▄▄▄▄█ ▄▄▄▄█ ▄   ▄             ║   "
 PRINT "      ║            █▄▄▄▄█      █▄▄▄█ █▄▄▄█ █▄▄▄█ █▄▄▄█ █▄▄▄█             ║   "
 PRINT "      ║               █▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄█              ║   "
 PRINT "      ║                           Version 2.1                            ║   "
 PRINT "      ╠══════════════════════════════════════════════════════════════════╣   "
 PRINT "      ║  I would like to thank Thomas Hanlen III for making ADVBAS40     ║   "
 PRINT "      ║  available to the public. I have enjoyed this library. And,      ║   "
 PRINT "      ║  the routines are a programmers dream. This module is used       ║   "
 PRINT "      ║  to format the files used in the ACCOUNTING MODULE of QBUDDY.    ║   "
 PRINT "      ║  Working Routines: COPY FILES - DIRECTORY WILDCARD SCAN -        ║   "
 PRINT "      ║        READ TEXT FILES - EDITOR - PARAMETER CONFIG - ERROR       ║   "
 PRINT "      ║        TRAPS - HARDWARE CALLS - DOS SHELL BACKUP - 3D MENU       ║   "
 PRINT "      ║                                                                  ║   "
 PRINT "      ║  More to thank...not enough room. SHARE/TRASHCAN/COPY/CHANGE     ║   "
 PRINT "      ║    Joe Lincoln - LINX BBS [phone] - Houston, Texas        ║   "
 PRINT "      ║                                                                  ║   "
 PRINT "      ╚══════════════════════════ Press any key ═════════════════════════╝   "
    LOCATE 19, 26: COLOR 20, 15: PRINT "SETUP AND MAINTENANCE MODULE": COLOR 15, 4
GOSUB 1000
RETURN

SUB box (r1%, c1%, R2%, c2%, men%)

' DRAW A BOX AT SPECIFIED COORDINATE

      GLOOP$ = "║"
      BOXTOP = (c2% - c1%) - 1: BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187)
      BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
      MIDBOX$ = CHR$(204) + STRING$(BOXTOP, 205) + CHR$(185)
      LOCATE r1%, c1%: PRINT BOXTOP$; : FOR E1% = r1% + 1 TO R2% - 1
      LOCATE E1%, c1%: PRINT GLOOP$; : LOCATE E1%, c2%: PRINT GLOOP$; : NEXT
      LOCATE R2%, c1%: PRINT BOXBOTTOM$;
      IF men% > 0 THEN   'Prints optional top and bottom bars in box
       LOCATE r1% + 3, c1%: PRINT MIDBOX$;
       LOCATE R2% - 2, c1%: PRINT MIDBOX$;
       END IF

END SUB

SUB box.text (tl$, r1%, c1%, fgd, bkg, ofg, obk)

      ' BOX TEXT AT SPECIFIED COORDINATE
      'This routine will box a one-line string of text in the color
      'of your choice at the starting coordinate you choose.
      'TL$ is the text, r1% is the starting row, c1% is the starting column.
      'fgd and bkg are the fore and background colors of the boxed text.
      'ofg and obk are the colors to restore after you've boxed the text.


    GLOOP$ = "║"
    BOXTOP = LEN(tl$) + 2
    BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
    MIDBOX$ = GLOOP$ + " " + tl$ + " " + GLOOP$
    COLOR fgd, bkg
    LOCATE r1%, c1%: PRINT BOXTOP$; : E1% = r1% + 1: R2% = E1% + 1
    LOCATE E1%, c1%: PRINT MIDBOX$;
    LOCATE R2%, c1%: PRINT BOXBOTTOM$;
    COLOR ofg, obk  'switch to these text colors after boxing the text

END SUB

SUB center (whichline, tl$)

 'This is a simple routine that centers a string of text TL$
 'on line number WHICHLINE. You can use it anywhere.

    tl = LEN(tl$)
    tl = INT((80 - tl) / 2)
    LOCATE whichline, tl
    PRINT tl$;


END SUB

SUB hold
WHILE INKEY$ = "": WEND

END SUB

SUB infile (PAT.PATH$, APT.PATH$, inflg%, FILENAME$, fc%, bc%, SYS.PATH$, ERCD%, handle%, faccess%, mode%, SUB.PATH$)
SUB$ = STRING$(64, 0): DRV$ = "x"
DEFINT A-Z

init.infile:
FIL$ = SPACE$(12): CLS

inflg% = 0: FILENAME$ = ""


begin.infile:
   LABEL$ = "Directories Scan ": v = 7
   page% = 0
CALL makewindow(10, 10, 70, 14, LABEL$, 1, 3, fc%, bc%, page%)

getdrive:

    a$ = "Wildcards are acceptable *.* ?": center 4, a$
    a$ = "Defaults to current directory": center 5, a$
    a$ = "Press RETurn to EXIT": center 7, a$
    LOCATE 12, 12: INPUT "Enter search path and filespec:  "; IN.STR$
scandr:
CLS : PRINT
PRINT "   ┌──────────────────────────────────────────────────────────────────────┐"
PRINT "   │ ╔════════════════════════════════════════╗╔════════════════════════╗ │"
PRINT "   │ ║ FILENAME   │  DATE  │   TIME  │  SIZE  ║║                        ║ │"
PRINT "   │ ╚════════════════════════════════════════╝╚════════════════════════╝ │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   │                                                                      │"
PRINT "   └──────────────────────────────────────────────────────────────────────┘"



LOCATE 4, 50: COLOR bc%, fc%: PRINT " PATH " + RTRIM$(IN.STR$) + " "; : COLOR fc%, bc%
'ty% = 2
'CALL makewindow(LCOL%, TROW%, RCOL%, BROW%, LABEL$, FRAME%, ty%, fc%, bc%, PAGE%)
'LOCATE 6, 6: PRINT "FILENAME        DATE       TIME        SIZE";
    FILENAME$ = UCASE$(IN.STR$)

   seekattr = 23 ' seek read-only, normal, hidden, system, and directory files

   CMD$ = FILENAME$
   IF CMD$ = "" THEN inflg% = 1: GOTO bail.out

   I = INSTR(CMD$, " ")
   IF I THEN FIL$ = LEFT$(CMD$, I - 1): CMD$ = MID$(CMD$, I + 1) ELSE FIL$ = CMD$: GOTO DoIt

   I = INSTR(CMD$, " ")
   IF I THEN parm1$ = LEFT$(CMD$, I - 1): CMD$ = MID$(CMD$, I + 1) ELSE parm1$ = CMD$: GOTO DoIt

   I = INSTR(CMD$, " ")
   IF I THEN parm2$ = LEFT$(CMD$, I - 1): parm3$ = MID$(CMD$, I + 1) ELSE parm2$ = CMD$

DoIt:
   IF parm1$ = "" THEN GOTO Display
   IF INSTR(parm1$, "/") THEN p$ = parm1$: GOSUB ExtractDate ELSE IF INSTR(parm1$, ":") THEN p$ = parm1$: GOSUB ExtractTime ELSE p$ = parm1$: GOSUB ExtractAttr

   IF parm2$ = "" THEN GOTO Display
   IF INSTR(parm2$, "/") THEN p$ = parm2$: GOSUB ExtractDate ELSE IF INSTR(parm2$, ":") THEN p$ = parm2$: GOSUB ExtractTime ELSE p$ = parm2$: GOSUB ExtractAttr

   IF parm3$ = "" THEN GOTO Display
   IF INSTR(parm3$, "/") THEN p$ = parm3$: GOSUB ExtractDate ELSE IF INSTR(parm3$, ":") THEN p$ = parm3$: GOSUB ExtractTime ELSE p$ = parm3$: GOSUB ExtractAttr

Display:
    DRV$ = LEFT$(FIL$, 1)
    a$ = STRING$(70, 32): center 23, a$
    FIL$ = FIL$ + CHR$(0)
    a = ASC(FIL$)
    IF a < 65 OR a > 68 THEN DRV$ = LEFT$(SYS.PATH$, 1)
CALL diskstat(DRV$, fre.clust%, tot.clust%, bytes.sec%, secs.clust%)
    cluster.size# = CDBL(bytes.sec%) * CDBL(secs.clust%)
    free.disk.space# = CDBL(fre.clust%) * cluster.size#
    tot.disk.spc# = CDBL(tot.clust%) * cluster.size#

CALL drvspace(DRV$, a%, b%, c%)
    free# = CDBL(a%) * CDBL(b%) * CDBL(c%)
    free$ = STR$(free#)
    LOCATE 21, 5: PRINT " Total Disk Space:"; tot.disk.spc#; " |  Free Space:"; free.disk.space#; " | Cluster:"; cluster.size#;

    CALL findfirstf(FIL$, seekattr, ERCD%)
    IF ERCD% THEN GOSUB uh.oh ELSE GOTO gofor.next
    GOTO begin.infile

gofor.next:
   WHILE ERCD% = 0
    GOSUB DisplayFile
    CALL findnextf(ERCD%)
   WEND
stop.here:
'A$ = STRING$(70, 32): center 23, A$


    a$ = "Press any key to continue": center 23, a$
    a$ = INKEY$: IF a$ = "" THEN GOTO stop.here
   GOTO bail.out

ExtractTime:
   I = INSTR(p$, ":")
   hour = VAL(p$)
   p$ = MID$(p$, I + 1)
   minute = VAL(p$)
   I = INSTR(p$, ":")
   IF I THEN Second = VAL(MID$(p$, I + 1))
   stime = -1
   RETURN

ExtractDate:
   I = INSTR(p$, "/")
   mnth = VAL(p$)
   p$ = MID$(p$, I + 1)
   DAY = VAL(p$)
   I = INSTR(p$, "/")
   IF I THEN YEAR = VAL(MID$(p$, I + 1)) ELSE YEAR = VAL(MID$(DATE$, 7))
   sdate = -1
   RETURN

ExtractAttr:
   attr = 0
   CALL upcase(p$)
   IF INSTR(p$, "R") THEN attr = attr + 1
   IF INSTR(p$, "H") THEN attr = attr + 2
   IF INSTR(p$, "S") THEN attr = attr + 4
   IF INSTR(p$, "D") THEN attr = attr + 16
   IF INSTR(p$, "A") THEN attr = attr + 32
   sattr = -1
   RETURN

DisplayFile:
   v = v + 1
   KY$ = INKEY$
   IF KY$ = CHR$(19) THEN WHILE INKEY$ = "": WEND  '  handle CTRL-S for pause
   DNAME$ = SPACE$(12)
   CALL getnamef(DNAME$, dlen)
   CALL GetTimeF(dhour, dmin, dsec)
   CALL GetDateF(dmnth, dday, dyear)
   CALL GetAttrF(dattr)
   CALL GetSizeF(sizelow%, sizehigh%)
   sizelow# = CDBL(sizelow%)
   IF sizelow% < 0 THEN sizelow# = sizelow# + 65536#
   filesize# = sizelow# + CDBL(sizehigh%) * 65536#
   IF v >= 20 THEN v = 8: GOSUB wait.up
   LOCATE v, 7: PRINT DNAME$; "   "; fnf$(dmnth); "/"; fnf$(dday); "/"; fnf$(dyear); "   "; fnf$(dhour); ":"; fnf$(dmin); ":"; fnf$(dsec); "   "; filesize#; "  ";
   pattr = dattr: GOSUB DisplayAttr
   IF NOT (sdate OR stime OR sattr) THEN RETURN

   DNAME$ = LEFT$(DNAME$, dlen) + CHR$(0)
   PRINT "   ------>     ";

   IF sdate AND NOT stime THEN hour = dhour: minute = dmin: Second = dsec
   IF stime AND NOT sdate THEN DAY = dday: mnth = dmnth: YEAR = dyear

   IF sdate OR stime THEN CALL setftd(DNAME$, mnth, DAY, YEAR, hour, minute, Second)
   IF sdate THEN PRINT fnf$(mnth); "/"; fnf$(DAY); "/"; fnf$(YEAR); "   ";  ELSE PRINT SPACE$(11);
   IF stime THEN PRINT fnf$(hour); ":"; fnf$(minute); ":"; fnf$(Second); "   ";  ELSE PRINT SPACE$(11);

   IF NOT sattr THEN RETURN
   IF sattr THEN CALL SetFattr(DNAME$, attr)
   pattr = attr: GOSUB DisplayAttr
   RETURN

DisplayAttr:
'IF pattr = 0 THEN PRINT "   ";
    IF pattr AND 1 THEN PRINT "   ";
    IF pattr AND 2 THEN PRINT "   ";
    IF pattr AND 4 THEN PRINT "   ";
    IF pattr AND 16 THEN PRINT "DIR";
    IF pattr AND 32 THEN PRINT "   ";
   RETURN

wait.up:
    a$ = STRING$(70, 32): center 23, a$
    center 23, "More Y-N": SOUND 250, 2
    ALLOW$ = "YN": KY$ = "x": CALL getkey(ALLOW$, KY$)
    IF KY$ = "N" THEN GOTO bail.out
    FOR vc% = 8 TO 19: LOCATE vc%, 5: PRINT STRING$(60, 32); : NEXT vc%
    RETURN
uh.oh:
CALL upcase(FIL$): a$ = "Path not found to  " + FIL$ + "  -> Press any key": center 12, a$
RETURN
bad.news:
    a$ = INPUT$(1)
    inflg% = 1


bail.out:

END SUB

DEFSNG A-Z
SUB menu (fgd, BKGD, brdr, PAT.PATH$, APT.PATH$, PROG.NAME$, PRINTER$, ver$, fc%, bc%, TODAY.DATE.STR$, inflg%, SYS.PATH$)

'This is the heart of the program.

COLOR fgd, BKGD, brdr
      REM
      REM
step1:
      a$ = ver$
      CALL center(23, a$)
      a$ = TODAY.DATE.STR$
      LOCATE 2, 60: PRINT a$;
      row = 8: col = 20: '     SET ROW AND COLUMN FOR MENU
      C1F = fgd: C1B = BKGD'   SET COLOR CODES
      C2F = BKGD: C2B = fgd: '       SET BAR COLOR TO COLOR 0,2
      'M$(1) = "ADD A NAME": M$(2) = "UPDATE A NAME": M$(3) = "DELETE A NAME": M$(4) = "FIND A NAME": M$(5) = "FILTER THE LIST": M$(6) = "SORT THE LIST": M$(7) = "PRINT THE LIST": M$(8) = "QUIT THE PROGRAM"
      'np = 8:
      '
step2:

GOSUB step3
      CLS
      GOTO menu.end
      GOTO step1
      GOTO step2
      '
      '
step3:
      COLOR C1F, C1B: ' CLS
      CALL center(7, "MENU SELECTIONS")
      CALL center(row + 1, "Use <ARROWS> to select <ENTER> to Choose")

      FOR J = 1 TO 16: x$ = INKEY$: NEXT: CH = 1
      LS = 2: FOR J = 1 TO np: IF LEN(m$(J)) > LS THEN LS = LEN(m$(J))
      NEXT: ML$ = "##  \" + SPACE$(LS - 1) + "\": SL = col + 18 - LEN(ML$) / 2
      FOR K = 1 TO np: LOCATE row + 2 + K, SL: PRINT USING ML$; K, m$(K): NEXT
step4:
    LOCATE row + 2 + CH, SL: COLOR C2F, C2B: PRINT USING ML$; CH, m$(CH): COLOR C1F, C1B: TD = CH
step5:
      CALL getkbd(INSERT%, capslock%, numlocl%, scrolock%)
    IF capslock% THEN LOCATE 24, 56: PRINT "CAPS";  ELSE LOCATE 24, 56: PRINT "    ";
    IF numlocl% THEN LOCATE 24, 62: PRINT "NUM";  ELSE LOCATE 24, 62: PRINT "    ";
    IF scrolock% THEN LOCATE 24, 68: PRINT "SCRL";  ELSE LOCATE 24, 68: PRINT "     ";
    IF INSERT% THEN LOCATE 24, 50: PRINT "INS";  ELSE LOCATE 24, 50: PRINT "    ";

      CALL tyme
      x$ = INKEY$: IF LEN(x$) THEN KP = ASC(RIGHT$(x$, 1)) ELSE GOTO step5

      IF KP = 72 THEN CH = CH - 1: IF CH < 1 THEN CH = np
      IF KP = 80 THEN CH = CH + 1: IF CH > np THEN CH = 1
      IF x$ >= "1" AND x$ <= "9" THEN IF VAL(x$) >= 1 AND VAL(x$) <= np THEN CH = VAL(x$): RETURN
      IF KP = 13 THEN RETURN
      IF KP <> 72 AND KP <> 80 THEN KP = KP - 48: IF KP < 1 OR KP > np THEN PRINT CHR$(7): GOTO step5 ELSE CH = KP
      IF CH = TD THEN GOTO step5 ELSE LOCATE row + 2 + TD, SL: PRINT USING ML$; TD, m$(TD): GOTO step4

menu.end:

END SUB

SUB rmsg (whichline, tl$)
'This routine also centers a string of text TL$ on line number WHICLINE.
'Unlike the CENTER subroutine, it clears the line before printing the
'centered text. You can use this anywhere, too."


    tl = LEN(tl$)
    tl = INT((80 - tl) / 2)
    LOCATE whichline, 2
    PRINT STRING$(77, 32);
    LOCATE whichline, tl
    PRINT tl$;

END SUB

SUB Sclr (fc%, bc%)
FOR v = 5 TO 21: LOCATE v, 3: COLOR fc%, bc%: PRINT STRING$(76, 32)
NEXT v
END SUB

SUB tyme
TT$ = TIME$
Hr = VAL(TT$)
IF Hr < 12 THEN Ampm$ = "AM" ELSE Ampm$ = "PM"
IF Hr > 12 THEN Hr = Hr - 12
LOCATE 2, 4: PRINT STR$(Hr); RIGHT$(TT$, 6); Ampm$
END SUB